

'--------------------------------------------------
' Hands-On 17-1
'--------------------------------------------------

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
        Cancel As Boolean)
    If MsgBox("Would you like to copy " & vbCrLf _
        & "this worksheet to " & vbCrLf _
        & "a new workbook?", vbQuestion + vbYesNo) = vbYes Then
        Sheets(ActiveSheet.Name).Copy
    End If
End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
        Cancel As Boolean)

    Dim wkb As Workbook
    Set wkb = ActiveWorkbook

    Cancel = False

    If MsgBox("Would you like to copy " & vbCrLf _
        & "this worksheet to " & vbCrLf _
        & "a new workbook?", vbQuestion + vbYesNo) = vbYes Then
        Sheets(ActiveSheet.Name).Copy
        wkb.Activate
    End If
End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _ 
		Cancel As Boolean)
	' abort the built-in save event
	Cancel = True
	' call your own saving procedure
	MyCustomSaveProcedure
End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
        Cancel As Boolean)

    If SaveAsUI = True Then Exit Sub
    Dim wkb As Workbook
    Set wkb = ActiveWorkbook

    Cancel = False

    If MsgBox("Would you like to copy " & vbCrLf _
        & "this worksheet to " & vbCrLf _
        & "a new workbook?", vbQuestion + vbYesNo) = vbYes Then
        Sheets(ActiveSheet.Name).Copy
        wkb.Activate
    End If
End Sub


'--------------------------------------------------
' Hands-On 17-2
'--------------------------------------------------

Sub EnterData()
    With ActiveSheet.Range("A1:B1")
        .Font.Color = vbRed
        .Value = 15
    End With
    Application.EnableEvents = False
    ActiveWorkbook.Save
    Application.EnableEvents = True
End Sub


'--------------------------------------------------
' Hands-On 17-3
'--------------------------------------------------

Dim shtName As String

Private Sub Worksheet_Activate()
    shtName = ActiveSheet.Name
    Range("B2").Select
End Sub


'--------------------------------------------------
' Hands-On 17-4
'--------------------------------------------------

Private Sub Worksheet_Deactivate()
    MsgBox "You deactivated " & _
        shtName & "." & vbCrLf & _
        "You switched to " & _
        ActiveSheet.Name & "."
End Sub


'--------------------------------------------------
' Hands-On 17-5
'--------------------------------------------------

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    Dim myRange As Range
    
    On Error Resume Next
    Set myRange = Intersect(Range("A1:A10"), Target)
    If Not myRange Is Nothing Then
       MsgBox "Data entry or edits are not permitted."
    End If
End Sub


'--------------------------------------------------
' Hands-On 17-6
'--------------------------------------------------

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Application.EnableEvents = False
        Target = UCase(Target)
        Columns(Target.Column).AutoFit
    Application.EnableEvents = True
End Sub


'--------------------------------------------------
' Hands-On 17-7
'--------------------------------------------------

Private Sub Worksheet_Calculate()
    MsgBox "The worksheet was recalculated."
End Sub


'--------------------------------------------------
' Hands-On 17-8
'--------------------------------------------------

Private Sub Worksheet_BeforeDoubleClick(ByVal _
       Target As Range, Cancel As Boolean)
    If Target.Address = "$C$9" Then
        MsgBox "No double-clicking, please."
        Cancel = True
    Else
        MsgBox "You may edit this cell."
    End If
End Sub


'--------------------------------------------------
' Hands-On 17-9
'--------------------------------------------------

Private Sub Worksheet_BeforeRightClick(ByVal _
    Target As Range, Cancel As Boolean)

    With Application.CommandBars("Cell")
        .Reset
        If Target.Rows.Count > 1 Or _
            Target.Columns.Count > 1 Then
            With .Controls.Add(Type:=msoControlButton, _
                    before:=1, temporary:=True)
                    .Caption = "Print..."
                    .OnAction = "PrintMe"
            End With
        End If
    End With
End Sub


Sub PrintMe()
    Application.Dialogs(xlDialogPrint).Show arg12:=1
End Sub


'--------------------------------------------------
' Hands-On 17-10
'--------------------------------------------------

Private Sub Workbook_Activate()
    MsgBox "This workbook contains " & _
        ThisWorkbook.Sheets.Count & " sheets."
End Sub


'--------------------------------------------------
' Hands-On 17-11
'--------------------------------------------------

Private Sub Workbook_Deactivate()
    Dim cell As Range
    For Each cell In ActiveSheet.UsedRange
        If Not IsEmpty(cell) Then
            Debug.Print cell.Address & ":" & cell.Value
        End If
    Next
End Sub


'--------------------------------------------------
' Hands-On 17-12
'--------------------------------------------------

Private Sub Workbook_Open()
    ActiveSheet.Range("A1").Value = Format(Now(), "mm/dd/yyyy")
    Columns("A").AutoFit
End Sub


'--------------------------------------------------
' Hands-On 17-13
'--------------------------------------------------

Private Sub Workbook_BeforeSave(ByVal _
        SaveAsUI As Boolean, Cancel As Boolean)
    If SaveAsUI = True And _
        ThisWorkbook.Path = vbNullString Then
        MsgBox "This document has not yet " _
            & "been saved." & vbCrLf _
        & "The Save As dialog box will be displayed."
    ElseIf SaveAsUI = True Then
        MsgBox "You are not allowed to use " _
        & "the SaveAs option. "
        Cancel = True
    End If
End Sub


'--------------------------------------------------
' Hands-On 17-14
'--------------------------------------------------

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Dim response As Integer
    response = MsgBox("Do you want to  " & vbCrLf & _
        "print the workbook's full name in the footer?", _
        vbYesNo)
    If response = vbYes Then
        ActiveSheet.PageSetup.LeftFooter = _
            ThisWorkbook.FullName
    Else
        ActiveSheet.PageSetup.LeftFooter = ""
    End If
End Sub


'--------------------------------------------------
' Hands-On 17-15
'--------------------------------------------------

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If MsgBox("Do you want to change " & vbCrLf _
        & " workbook properties before closing?", _
            vbYesNo) = vbYes Then
        Application.Dialogs(xlDialogProperties).Show
    End If
End Sub


'--------------------------------------------------
' Hands-On 17-16
'--------------------------------------------------

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    If MsgBox("Do you want to place  " & vbCrLf _
        & "the new sheet at the beginning " & vbCrLf _
        & "of the workbook?", vbYesNo) = vbYes Then
                Sh.Move before:=ThisWorkbook.Sheets(1)
    Else
        Sh.Move After:=ThisWorkbook.Sheets( _
                ThisWorkbook.Sheets.Count)
        MsgBox Sh.Name & _
        " is now the last sheet in the workbook."
    End If
End Sub


'--------------------------------------------------
' Hands-On 17-17
'--------------------------------------------------

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
    Wn.GridlineColor = vbYellow
End Sub


'--------------------------------------------------
' Hands-On 17-18
'--------------------------------------------------

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
    MsgBox "You have just deactivated " & Wn.Caption
End Sub


'--------------------------------------------------
' Hands-On 17-19
'--------------------------------------------------

Private Sub Workbook_WindowResize(ByVal Wn As Window)
    If Wn.WindowState <> xlMaximized Then
        Wn.Left = 0
        Wn.Top = 0
    End If
End Sub


'--------------------------------------------------
' Hands-On 17-20
' No Code in this Hands-On.
' Please follow the instructions in the book.
'--------------------------------------------------


'--------------------------------------------------
' Hands-On 17-21
'--------------------------------------------------

Private Sub Chart_Activate()
    MsgBox "You've activated the chart sheet."
End Sub


Private Sub Chart_Deactivate()
    MsgBox "It looks like you want to leave the " _
     & "chart sheet."
End Sub


Private Sub Chart_Select(ByVal ElementID As Long, _
            ByVal Arg1 As Long, ByVal Arg2 As Long)
    If Arg1 <> 0 And Arg2 <> 0 Then
        MsgBox ElementID & ", " & Arg1 & ", " & Arg2
    End If
    If ElementID = 4 Then
        MsgBox "You've selected the chart title."
    ElseIf ElementID = 24 Then
        MsgBox "You've selected the chart legend."
    ElseIf ElementID = 12 Then
        MsgBox "You've selected the legend key."
    ElseIf ElementID = 13 Then
        MsgBox "You've selected the legend entry."
    End If
End Sub


Private Sub Chart_Calculate()
    MsgBox "The data in your spreadsheet has " & vbCrLf _
        & "changed. Your chart has been updated."
End Sub

Private Sub Chart_BeforeRightClick(Cancel As Boolean)
    Cancel = True
End Sub


Private Sub Chart_MouseDown(ByVal Button As Long, _
    ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
    If Button = 1 Then
         MsgBox "You pressed the left mouse button. "
    ElseIf Button = 2 Then
        MsgBox "You pressed the right mouse button. "
    Else
        MsgBox "You pressed the middle mouse button. "
    End If
End Sub


'--------------------------------------------------
' Hands-On 17-22
'--------------------------------------------------

' Enter the following in the Class Module

Public WithEvents xlChart As Excel.Chart

Private Sub xlChart_Activate()
    MsgBox "You've activated a chart embedded in  " & _
        ActiveSheet.Name & "."
End Sub


' Enter the following in ThisWorkbook code window

' set up a reference to a class module
Dim myChart As New clsChart

Sub InitializeChart()
    
    ' you must run this procedure before event procedures
    ' written in clsChart class module can be triggered for
    ' the chart embedded in Sheet1
    
    ' connect the class module with the Excel chart object
    Set myChart.xlChart = _
        Worksheets("Sheet1").ChartObjects(1).Chart
End Sub


'--------------------------------------------------
' Hands-On 17-23
'--------------------------------------------------

' Class module procedures

Public WithEvents App As Application

Private Sub App_NewWorkbook(ByVal Wb As Workbook)
    Application.DisplayAlerts = False
    If Wb.Sheets.Count = 3 Then
        Sheets(Array(2, 3)).Delete
    End If
    Application.DisplayAlerts = True
End Sub


Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
    If Wb.FileFormat = xlCSV Then
       If MsgBox("Do you want to save this " & vbCrLf _
         & "file as an Excel workbook?", vbYesNo, _
            "Original file format: " _
         & "comma delimited file") = vbYes Then
                Wb.SaveAs FileFormat:=xlWorkbookNormal
        End If
    End If
End Sub

Private Sub App_WorkbookBeforeSave(ByVal _
    Wb As Workbook, ByVal SaveAsUI As Boolean, _
                Cancel As Boolean)
                                               
    If Wb.Path <> vbNullString Then
       ActiveWindow.Caption = Wb.FullName & _
        " [Last Saved: " & Time & "]"
    End If
End Sub


Private Sub App_WorkbookBeforePrint(ByVal _
            Wb As Workbook, Cancel As Boolean)
    Wb.PrintOut Copies:=2
End Sub


Private Sub App_WorkbookBeforeClose(ByVal _
            Wb As Workbook, Cancel As Boolean)
    Dim r As Integer
    Sheets.Add
    r = 1
    For Each p In Wb.BuiltinDocumentProperties
      On Error GoTo ErrorHandle
        Cells(r, 1).Value = p.Name & " = " & _
            ActiveWorkbook.BuiltinDocumentProperties _
            .Item(p.Name).Value
        r = r + 1
    Next
    Exit Sub
ErrorHandle:
        Cells(r, 1).Value = p.Name
        Resume Next
End Sub


Private Sub App_SheetSelectionChange(ByVal Sh _
            As Object, ByVal Target As Range)

    If Selection.Count > 1 Or _
            (Selection.Count < 2 And _
            IsEmpty(Target.Value)) Then
        Application.StatusBar = Target.Address
    Else
        Application.StatusBar = Target.Address & _
                "(" & Target.Value & ")"
    End If
End Sub


Private Sub App_WindowActivate(ByVal _
    Wb As Workbook, ByVal Wn As Window)

    Wn.DisplayFormulas = True

End Sub


' Standard module procedures
Dim DoThis As New clsApplication

Public Sub InitializeAppEvents()
    Set DoThis.App = Application
End Sub


Public Sub CancelAppEvents()
    Set DoThis.App = Nothing
End Sub


'--------------------------------------------------
' Hands-On 17-24
'--------------------------------------------------

' code in the Class Module

Public WithEvents qryTbl As QueryTable

Private Sub qryTbl_BeforeRefresh(Cancel As Boolean)
   Response = MsgBox("Are you sure you " _
        & " want to refresh now?", vbYesNoCancel)
    If Response = vbNo Then Cancel = True
End Sub

Private Sub qryTbl_AfterRefresh(ByVal Success As _
         Boolean)
  If Success Then
      MsgBox "The data has been refreshed."
  Else
      MsgBox "The query failed."
  End If
End Sub


' code in the Standard Module

Dim sampleQry As New clsQryTbl

Public Sub Auto_Open()
   ' connect the class module and its objects with the Query object
     Set sampleQry.qryTbl = ActiveSheet.ListObjects(1).QueryTable
End Sub
